home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / animat4a / frmanigi.frm (.txt) next >
Visual Basic Form  |  1999-10-18  |  7KB  |  187 lines
  1. VERSION 5.00
  2. Begin VB.Form frmMain 
  3.    Caption         =   "Animated GIF"
  4.    ClientHeight    =   1905
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   6195
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   1905
  10.    ScaleWidth      =   6195
  11.    StartUpPosition =   3  'Windows Default
  12.    Begin VB.TextBox txFile 
  13.       Height          =   330
  14.       Left            =   165
  15.       TabIndex        =   1
  16.       Top             =   150
  17.       Width           =   3780
  18.    End
  19.    Begin VB.Timer AnimationTimer 
  20.       Enabled         =   0   'False
  21.       Interval        =   1000
  22.       Left            =   195
  23.       Top             =   555
  24.    End
  25.    Begin VB.CommandButton btnPlay 
  26.       Caption         =   "PLAY"
  27.       Height          =   465
  28.       Left            =   4200
  29.       TabIndex        =   0
  30.       Top             =   105
  31.       Width           =   1380
  32.    End
  33.    Begin VB.Image AnimatedGIF 
  34.       Appearance      =   0  'Flat
  35.       Height          =   900
  36.       Index           =   0
  37.       Left            =   855
  38.       Top             =   615
  39.       Width           =   1500
  40.    End
  41. Attribute VB_Name = "frmMain"
  42. Attribute VB_GlobalNameSpace = False
  43. Attribute VB_Creatable = False
  44. Attribute VB_PredeclaredId = True
  45. Attribute VB_Exposed = False
  46. Dim RepeatTimes&
  47. Dim RepeatCount&
  48. Dim FrameCount&
  49. Dim TotalFrames&
  50. Private Sub btnPlay_Click()
  51.        
  52.     Call LoadAniGif(txFile.Text, AnimatedGIF)
  53. End Sub
  54. Sub LoadAniGif(xFile As String, xImgArray)
  55.     If Not IIf(Dir$(xFile) = "", False, True) Or xFile = "" Then
  56.         MsgBox "File not found.", vbExclamation, "File Error"
  57.         Exit Sub
  58.     End If
  59.         
  60.     Dim F1, F2
  61.     Dim AnimatedGIFs() As String
  62.     Dim imgHeader As String
  63.     Static buf$, picbuf$
  64.     Dim fileHeader As String
  65.     Dim imgCount
  66.     Dim i&, j&, xOff&, yOff&, TimeWait&
  67.     Dim GifEnd
  68.     GifEnd = Chr(0) & "!
  69.     AnimationTimer.Enabled = False
  70.     For i = 1 To xImgArray.Count - 1
  71.         Unload xImgArray(i)
  72.     Next i
  73.     F1 = FreeFile
  74. On Error GoTo badFile:
  75.     Open xFile For Binary Access Read As F1
  76.         buf = String(LOF(F1), Chr(0))
  77.         Get #F1, , buf
  78.     Close F1
  79.     i = 1
  80.     imgCount = 0
  81.     j = (InStr(1, buf, GifEnd) + Len(GifEnd)) - 2
  82.     fileHeader = Left(buf, j)
  83.     i = j + 2
  84.     If Len(fileHeader) >= 127 Then
  85.         RepeatTimes& = Asc(Mid(fileHeader, 126, 1)) + (Asc(Mid(fileHeader, 127, 1)) * CLng(256))
  86.     Else
  87.         RepeatTimes = 0
  88.     End If
  89.     Do
  90.         imgCount = imgCount + 1
  91.         j = InStr(i, buf, GifEnd) + Len(GifEnd)
  92.         If j > Len(GifEnd) Then
  93.             F2 = FreeFile
  94.             Open "tmp.gif" For Binary As F2
  95.                 picbuf = String(Len(fileHeader) + j - i, Chr(0))
  96.                 picbuf = fileHeader & Mid(buf, i - 1, j - i)
  97.                 Put #F2, 1, picbuf
  98.                 imgHeader = Left(Mid(buf, i - 1, j - i), 16)
  99.             Close F2
  100.             
  101.             TimeWait = ((Asc(Mid(imgHeader, 4, 1))) + (Asc(Mid(imgHeader, 5, 1)) * CLng(256))) * CLng(10)
  102.             If imgCount > 1 Then
  103.                 xOff = Asc(Mid(imgHeader, 9, 1)) + (Asc(Mid(imgHeader, 10, 1)) * CLng(256))
  104.                 yOff = Asc(Mid(imgHeader, 11, 1)) + (Asc(Mid(imgHeader, 12, 1)) * CLng(256))
  105.                 Load xImgArray(imgCount - 1)
  106.                 xImgArray(imgCount - 1).ZOrder 0
  107.                 xImgArray(imgCount - 1).Left = xImgArray(0).Left + (xOff * CLng(15))
  108.                 xImgArray(imgCount - 1).Top = xImgArray(0).Top + (yOff * CLng(15))
  109.             End If
  110.             xImgArray(imgCount - 1).Tag = TimeWait
  111.             xImgArray(imgCount - 1).Picture = LoadPicture("tmp.gif")
  112.             Kill ("tmp.gif")
  113.             
  114.             i = j '+ 1
  115.         End If
  116.         DoEvents
  117.     Loop Until j = Len(GifEnd)
  118.     If i < Len(buf) Then
  119.         F2 = FreeFile
  120.         Open "tmp.gif" For Binary As F2
  121.             picbuf = String(Len(fileHeader) + Len(buf) - i, Chr(0))
  122.             picbuf = fileHeader & Mid(buf, i - 1, Len(buf) - i)
  123.             Put #F2, 1, picbuf
  124.             imgHeader = Left(Mid(buf, i - 1, Len(buf) - i), 16)
  125.         Close F2
  126.         TimeWait = ((Asc(Mid(imgHeader, 4, 1))) + (Asc(Mid(imgHeader, 5, 1)) * CLng(256))) * CLng(10)
  127.         If imgCount > 1 Then
  128.             xOff = Asc(Mid(imgHeader, 9, 1)) + (Asc(Mid(imgHeader, 10, 1)) * CLng(256))
  129.             yOff = Asc(Mid(imgHeader, 11, 1)) + (Asc(Mid(imgHeader, 12, 1)) * CLng(256))
  130.             Load xImgArray(imgCount - 1)
  131.             xImgArray(imgCount - 1).ZOrder 0
  132.             xImgArray(imgCount - 1).Left = xImgArray(0).Left + (xOff * CLng(15))
  133.             xImgArray(imgCount - 1).Top = xImgArray(0).Top + (yOff * CLng(15))
  134.         End If
  135.         xImgArray(imgCount - 1).Tag = TimeWait
  136.         xImgArray(imgCount - 1).Picture = LoadPicture("tmp.gif")
  137.         Kill ("tmp.gif")
  138.     End If
  139.     FrameCount = 0
  140.     TotalFrames = xImgArray.Count - 1
  141. On Error GoTo badTime
  142.     AnimationTimer.Interval = CInt(xImgArray(0).Tag)
  143. badTime:
  144.     AnimationTimer.Enabled = True
  145. Exit Sub
  146. badFile:
  147.     MsgBox "File not found.", vbExclamation, "File Error"
  148. End Sub
  149. Private Sub AnimationTimer_Timer()
  150.     If FrameCount < TotalFrames Then
  151.         FrameCount = FrameCount + 1
  152.         AnimatedGIF(FrameCount).Visible = True
  153.         AnimationTimer.Interval = CLng(AnimatedGIF(FrameCount).Tag)
  154.     Else
  155.         FrameCount = 0
  156.         For i = 1 To AnimatedGIF.Count - 1
  157.             AnimatedGIF(i).Visible = False
  158.         Next i
  159.         AnimationTimer.Interval = CLng(AnimatedGIF(FrameCount).Tag)
  160.     End If
  161. '    For i = 0 To AnimatedGIF.Count
  162. '        If i = AnimatedGIF.Count Then
  163. '            If RepeatTimes > 0 Then
  164. '                RepeatCount = RepeatCount + 1
  165. '                If RepeatCount > RepeatTimes Then
  166. '                    AnimationTimer.Enabled = False
  167. '                    Exit Sub
  168. '                End If
  169. '            End If
  170. '            For j = 1 To AnimatedGIF.Count - 1
  171. '                AnimatedGIF(j).Visible = False
  172. '            Next j
  173. 'On Error GoTo badTime
  174. '            AnimationTimer.Interval = CLng(AnimatedGIF(0).Tag)
  175. 'badTime:
  176. '            Exit For
  177. '        End If
  178. '        If AnimatedGIF(i).Visible = False Then
  179. 'On Error GoTo badTime2
  180. '            AnimationTimer.Interval = CLng(AnimatedGIF(i).Tag)
  181. 'badTime2:
  182. '            AnimatedGIF(i).Visible = True
  183. '            Exit For
  184. '        End If
  185. '    Next i
  186. End Sub
  187.